home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / vis082s.arc / DOORS.PAS < prev    next >
Pascal/Delphi Source File  |  1991-04-17  |  9KB  |  374 lines
  1. {$R-,S-,I-,D-,F+,V-,B-,N-,L+,O+ }
  2.  
  3. unit doors;
  4.  
  5. interface
  6.  
  7. uses gentypes,modem,configrt,statret,gensubs,subs1,subs2,
  8.      userret,textret,overret1,mainr1,mainr2,pcboard;
  9.  
  10. procedure doorsmenu;
  11.  
  12. implementation
  13.  
  14. procedure doorsmenu;
  15.  
  16.   function numdoors:integer;
  17.   begin
  18.     numdoors:=filesize (dofile)
  19.   end;
  20.  
  21.   procedure seekdofile (n:integer);
  22.   begin
  23.     seek (dofile,n-1)
  24.   end;
  25.  
  26.   procedure opendofile;
  27.   var i:integer;
  28.   begin
  29.     assign (dofile,'Door');
  30.     reset (dofile);
  31.     if ioresult<>0 then begin
  32.       i:=ioresult;
  33.       rewrite (dofile)
  34.     end
  35.   end;
  36.  
  37.   procedure maybemakebatch (fn:lstr);
  38.   var tf:text;
  39.       d:boolean;
  40.   begin
  41.     if not issysop then exit;
  42.     writestr ('Make new batch file '+fn+'? *');
  43.     writeln (^M);
  44.     if not yes then exit;
  45.     assign (tf,fn);
  46.     rewrite (tf);
  47.     if ioresult<>0 then begin
  48.       writeln ('Couldn''t create file!');
  49.       exit
  50.     end;
  51.     writeln ('Enter text, blank line to end.'^M);
  52.     repeat
  53.       writestr ('=> &');
  54.       d:=length(input)=0;
  55.       if not d then writeln (tf,input)
  56.     until d;
  57.     textclose (tf);
  58.     writeln (^M'Batch file created!');
  59.     writelog (10,4,fn)
  60.   end;
  61.  
  62.   procedure getdoorinfo (var d:doorrec);
  63.   var m:message;
  64.   begin
  65.     writeln (^B^M'Enter information about this door:'^M);
  66.     d.info:=editor (m,false,false,'0','0')
  67.   end;
  68.  
  69.   function checkbatchname (var qq):boolean;
  70.   var i:lstr absolute qq;
  71.       p:integer;
  72.   begin
  73.     p:=pos('.',i);
  74.     if p<>0 then i[0]:=chr(p-1);
  75.     i:=i+'.BAT';
  76.     checkbatchname:=validfname(i)
  77.   end;
  78.  
  79.   procedure maybemakedoor;
  80.   var n:integer;
  81.       d:doorrec;
  82.   begin
  83.     if not issysop then begin
  84.        close(dofile);
  85.        exit;
  86.     end;
  87.     n:=numdoors+1;
  88.     writestr ('Make new door #'+strr(n)+'? *');
  89.     if not yes then exit;
  90.     writestr (^M'Name:');
  91.     if length(input)=0 then exit;
  92.     d.name:=input;
  93.     writestr ('Access level:');
  94.     if length(input)=0 then exit;
  95.     d.level:=valu(input);
  96.     writestr ('Name/path of batch file:');
  97.     if length(input)=0 then exit;
  98.     if not checkbatchname(input) then begin
  99.       writeln ('Invalid filename: '^S,input);
  100.       exit
  101.     end;
  102.     d.batchname:=configset.doordi+input;
  103.     writestr ('Ask user opening door for parameters? *');
  104.     d.getparams:=yes;
  105.     getdoorinfo (d);
  106.     if d.info<0 then exit;
  107.     d.numused:=0;
  108.     seekdofile (n);
  109.     write (dofile,d);
  110.     if not exist (d.batchname) then begin
  111.       writeln (^B'Can''t open batch file ',d.batchname);
  112.       maybemakebatch (d.batchname)
  113.     end;
  114.     writeln (^B^M'Door created!');
  115.     writelog (10,3,d.name)
  116.   end;
  117.  
  118.   function haveaccess (n:integer):boolean;
  119.   var d:doorrec;
  120.   begin
  121.     haveaccess:=false;
  122.     seekdofile (n);
  123.     read (dofile,d);
  124.     if ulvl>=d.level
  125.       then haveaccess:=true
  126.       else reqlevel (d.level)
  127.   end;
  128.  
  129.   procedure listdoors;
  130.   var d:doorrec;
  131.       cnt:integer;
  132.   begin
  133.     writehdr ('Available Doors');
  134.     seekdofile (1);
  135.     writeln ('    Name                         Level  Times used');
  136.     for cnt:=1 to numdoors do begin
  137.       read (dofile,d);
  138.       if ulvl>=d.level then begin
  139.         write (cnt:2,'. ');
  140.         tab (d.name,30);
  141.         writeln (d.level:3,d.numused:5);
  142.         if break then exit
  143.       end
  144.     end;
  145.     writeln
  146.   end;
  147.  
  148.   function getdoornum (txt:mstr):integer;
  149.   var g:boolean;
  150.       n:integer;
  151.   begin
  152.     getdoornum:=0;
  153.     g:=false;
  154.     repeat
  155.       writestr ('Door number to '+txt+' [?=list]:');
  156.       writeln;
  157.       if input='?' then listdoors else g:=true
  158.     until g;
  159.     if length(input)=0 then exit;
  160.     n:=valu(input);
  161.     if (n<1) or (n>numdoors)
  162.       then writeln ('Door number out of range!')
  163.       else if haveaccess(n)
  164.         then getdoornum:=n
  165.   end;
  166.  
  167.   procedure opendoor;
  168.   var n,bd,p:integer;
  169.       d:doorrec;
  170.       batchf,outf:text;
  171.       q:boolean;
  172.       tmp,params:lstr;
  173.   begin
  174.     n:=getdoornum ('open');
  175.     if n=0 then exit;
  176.     seekdofile (n);
  177.     read (dofile,d);
  178.     printtext (d.info);
  179.     if d.getparams then writestr ('Parameters:') else input:='';
  180.     params:=input;
  181.     p:=pos('>',input);
  182.     if p=0 then p:=pos('<',input);
  183.     if p=0 then p:=pos('|',input);
  184.     if p<>0 then begin
  185.       writestr ('You may not specify pipes in door parameters.');
  186.       exit
  187.     end;
  188.     writestr (^M'Press space to open the door, or X to abort');
  189.     if upcase(waitforchar)='X' then exit;
  190.     writeln ('Opening door: ',d.name);
  191.     q:=true;
  192.     repeat
  193.       assign (batchf,d.batchname);
  194.       reset (batchf);
  195.       if ioresult<>0 then begin
  196.         q:=false;
  197.         close (batchf);
  198.         iocode:=ioresult;
  199.         if not issysop
  200.           then
  201.             begin
  202.               fileerror ('Opendoor',d.batchname);
  203.               exit
  204.             end
  205.           else
  206.             begin
  207.               maybemakebatch (d.batchname);
  208.               if not exist (d.batchname) then exit
  209.             end
  210.       end
  211.     until q;
  212.     assign (outf,'DOOR.BAT');
  213.     rewrite (outf);
  214.     writeln (outf,'TEMPDOOR ',params);
  215.     textclose (outf);
  216.     assign (outf,'TEMPDOOR.BAT');
  217.     rewrite (outf);
  218.     while not eof(batchf) do begin
  219.       readln (batchf,tmp);
  220.       writeln (outf,tmp)
  221.     end;
  222.     if online then bd:=baudrate else bd:=0;
  223.     getdir (0,tmp);
  224.     writeln (outf,'cd '+tmp);
  225.     writeln (outf,'return');
  226.     textclose (batchf);
  227.     textclose (outf);
  228.     d.numused:=d.numused+1;
  229.     seekdofile (n);
  230.     write (dofile,d);
  231.     writelog (9,1,d.name);
  232.     updateuserstats (false);
  233.     writeurec;
  234.     writestatus;
  235.     definefiles;
  236.     writereturnbat;
  237.     ensureclosed;
  238.     halt (e_door)
  239.   end;
  240.  
  241.   procedure getinfo;
  242.   var n:integer;
  243.       d:doorrec;
  244.   begin
  245.     n:=getdoornum ('get information on');
  246.     if n=0 then exit;
  247.     seekdofile (n);
  248.     read (dofile,d);
  249.     writeln;
  250.     printtext (d.info)
  251.   end;
  252.  
  253.   procedure changedoor;
  254.   var n:integer;
  255.       d:doorrec;
  256.   begin
  257.     n:=getdoornum ('Change');
  258.     if n=0 then exit;
  259.     seekdofile (n);
  260.     read (dofile,d);
  261.     writeln ('Name: ',d.name);
  262.     writestr ('New name:');
  263.     if length(input)>0 then d.name:=input;
  264.     writeln (^M'Level: ',d.level);
  265.     writestr ('New level:');
  266.     if length(input)>0 then d.level:=valu(input);
  267.     writeln (^M'Batch file name: ',d.batchname);
  268.     writestr ('New batch file name:');
  269.     if length(input)>0 then
  270.       if checkbatchname (input)
  271.         then d.batchname:=input
  272.         else writeln ('Invalid filename: '^S,input);
  273.     maybemakebatch (d.batchname);
  274.     writeln;
  275.     printtext (d.info);
  276.     writestr (^M'Replace text [y/n]:');
  277.     if yes then
  278.       repeat
  279.         deletetext (d.info);
  280.         getdoorinfo (d);
  281.         if d.info<0 then writeln (^M'You must enter some information.')
  282.       until d.info>=0;
  283.     seekdofile (n);
  284.     write (dofile,d);
  285.     writelog (10,1,d.name)
  286.   end;
  287.  
  288.   procedure deletedoor;
  289.   var n,cnt:integer;
  290.       td,d:doorrec;
  291.       f:file;
  292.   begin
  293.     n:=getdoornum ('delete');
  294.     if n=0 then exit;
  295.     seekdofile (n);
  296.     read (dofile,d);
  297.     writestr ('Delete '+d.name+': Confirm:');
  298.     if not yes then exit;
  299.     writeln ('Deleting...');
  300.     seekdofile (n+1);
  301.     for cnt:=n to filesize(dofile)-1 do begin
  302.       read (dofile,td);
  303.       seekdofile (cnt);
  304.       write (dofile,td)
  305.     end;
  306.     seek (dofile,filesize(dofile)-1);
  307.     truncate (dofile);
  308.     deletetext (d.info);
  309.     writestr (^M'Erase disk file '+d.batchname+'? *');
  310.     if yes then begin
  311.       assign (f,d.batchname);
  312.       erase (f);
  313.       if ioresult<>0 then writeln ('(File not found)')
  314.     end;
  315.     writelog (10,2,d.name)
  316.   end;
  317.  
  318.   procedure sysopdoors;
  319.   var q:integer;
  320.   begin
  321.         if (not configset.remotedoor) and carrier then begin
  322.       writestr ('Sorry, remote door maintenance is not allowed!');
  323.       writestr ('(Please re-configure to change this setting)');
  324.       exit
  325.     end;
  326.     repeat
  327.       q:=menu('Sysop door','SDOORS','QCAD');
  328.       case q of
  329.         2:changedoor;
  330.         3:maybemakedoor;
  331.         4:deletedoor
  332.       end
  333.     until hungupon or (q=1) or (filesize(dofile)=0)
  334.   end;
  335.  
  336. var q:integer;
  337. begin
  338.   if not configset.allowdoor then begin
  339.     writestr ('All doors are locked.');
  340.     if issysop then writestr ('(Please re-configure to change this setting)');
  341.     fromdoor:=false;
  342.     returnto:='M';
  343.     exit
  344.   end;
  345.   if fromdoor then begin
  346.     fromdoor:=false;
  347.     if returnto='D' then writestr (^M^M^M'Welcome back to ViSiON!')
  348.   end;
  349.   cursection:=doorssysop;
  350.   opendofile;
  351.   if numdoors=0 then begin
  352.     writestr ('No doors exist!');
  353.     maybemakedoor;
  354.     if numdoors=0 then begin
  355.       close (dofile);
  356.       exit
  357.     end
  358.   end;
  359.   repeat
  360.     q:=menu('Doors','DOORS','QLOIH%@');
  361.     case q of
  362.       2:listdoors;
  363.       3:opendoor;
  364.       4:getinfo;
  365.       5:help ('Doors.hlp');
  366.       6:sysopdoors
  367.     end
  368.   until hungupon or (q=1) or (filesize(dofile)=0);
  369.   close (dofile)
  370. end;
  371.  
  372. begin
  373. end.
  374.